;;;;
;;; Nehe Lesson #27 - Shadows
;;; http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=27
;;; XMLisp version by John Miller, millejoh@mac.com, 08/31/09
;;; 

(in-package :xlui)

(use-package :lib.gl)

(defclass shadow-view (nehe-view)
  ()
  (:documentation "NeHe Lesson #27 - Shadows."))

(defparameter *shadow-infinity* 100) ; For calculating the extension vector in the shadow volume

(defstruct point
  x y z)

(defun point->gl-vertex3f (point)
  (get-pointer (%gl-vector (coerce (point-x point) 'single-float)
                           (coerce (point-y point) 'single-float)
                           (coerce (point-z point) 'single-float))))

(defstruct plane
  a b c d)

(defstruct face
  indices normals plane neighbor visible-p)

(defclass shadowed-object (agent-3d)
  ((faces :accessor faces :initarg :faces)
   (vertices :accessor vertices :initform nil)
   (source :accessor source :initarg :source)))

(defmethod initialize-instance :after ((self shadowed-object) &rest _)
  (declare (ignore _))
  (when (probe-file (source self))
    (load-shadow-object self)
    (setf (faces self) (set-connectivity self))))

(defun neighbor-p (face-a face-b)
  "Returns true if face-a and face-b share an edge and updates their neighbor-indices slot."
  (let ((indices-a (face-indices face-a))
        (indices-b (face-indices face-b)))
    (block index-iteration
      (dotimes (i 3)
        (let ((v1-a (elt indices-a i))
              (v2-a (elt indices-a (mod (1+ i) 3))))
          (log5:log-for (trace) "....")
          (dotimes (j 3)
            (let ((v1-b (elt indices-b j))
                  (v2-b (elt indices-b (mod (1+ j) 3))))
              (if (or (and (eql v1-a v1-b) (eql v2-a v2-b))
                      (and (eql v1-a v2-b) (eql v2-a v1-b)))
                ;; Two faces can have at most one edge in common, so if we have found
                ;; a neighbor then we are done!
                (return-from index-iteration t))))))
      (return-from index-iteration nil))))
      
(defun set-connectivity (shadow-object)
  (with-slots (faces vertices) shadow-object
    (let ((new-faces '()))
      (dolist (face-a faces (remove-if #'(lambda (x)
                                           (find x (remove x new-faces :count 1)))
                                       new-faces))
        (when (null (face-neighbor face-a)) ; We don't know what are this face's neighbors.
          (dolist (face-b (remove face-a faces))
            (when (neighbor-p face-a face-b)
              (setf (face-neighbor face-a) face-b)
              (setf (face-neighbor face-b) face-a))
            (push face-a new-faces)
            (push face-b new-faces)))))))
    

(defmethod calculate-plane ((obj shadowed-object) face)
  (with-slots (vertices) obj
    (let* ((idx (face-indices face))
           (v1 (nth (first idx) vertices))
           (v2 (nth (second idx) vertices))
           (v3 (nth (third idx) vertices))
           (v1.x (point-x v1)) (v1.y (point-y v1)) (v1.z (point-z v1))
           (v2.x (point-x v2)) (v2.y (point-y v2)) (v2.z (point-z v2))
           (v3.x (point-x v3)) (v3.y (point-y v3)) (v3.z (point-z v3)))
      (setf (plane-a (face-plane face)) (+ (* v1.y (- v2.z v3.z))
                                           (* v2.y (- v3.z v1.z))
                                           (* v3.y (- v1.x v2.x)))
            (plane-b (face-plane face)) (+ (* v1.z (- v2.x v3.x))
                                           (* v2.z (- v3.x v1.x))
                                           (* v3.z (- v1.x v2.x)))
            (plane-c (face-plane face)) (+ (* v1.x (- v2.y v3.y))
                                           (* v2.x (- v3.y v1.y))
                                           (* v3.x (- v1.y v2.y)))
            (plane-d (face-plane face)) (+ (- (* v1.x (- (* v2.y v3.z) (* v3.y v2.z))))
                                           (* v2.x (- (* v3.y v1.z) (* v1.y v3.z)))
                                           (* v3.x (- (* v1.y v2.z) (* v2.y v1.z))))))))

(defmethod cast-shadow ((obj shadowed-object) light-position)
  ;; Find which faces are facing the light source.
  (with-slots (faces) obj
    (dolist (face faces)
      (let* ((p (face-plane face))
             (side (+ (* (plane-a p) (gl-aref light-position 0))
                      (* (plane-b p) (gl-aref light-position 1))
                      (* (plane-c p) (gl-aref light-position 2))
                      (plane-d p))))
        (if (> side 0)
          (setf (face-visible-p face) t)
          (setf (face-visible-p face) nil))))
    ;; Set GL state for rendering the shadow.
    (glPushAttrib (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT GL_ENABLE_BIT GL_POLYGON_BIT GL_STENCIL_BUFFER_BIT))
    (glDisable GL_LIGHTING)
    (glDepthMask GL_FALSE)
    (glDepthFunc GL_LEQUAL)
    (glEnable GL_STENCIL_TEST)
    (glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE)
    (glStencilFunc GL_ALWAYS 1 #xFFFFFFFF)
    ;; Render the shadows
    (glFrontFace GL_CCW) ; First pass, increasing the stencil value.
    (glStencilOp GL_KEEP GL_KEEP GL_INCR)
    (do-shadow-pass obj light-position)
    (glFrontFace GL_CW) ; Second pass, decreasing the stencil value.
    (glStencilOp GL_KEEP GL_KEEP GL_DECR)
    (do-shadow-pass obj light-position)
    ;; Enable rendering to the color buffer for all elements.
    (glFrontFace GL_CCW)
    (glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE)
    ;; Draw a shadowing rectangle covering the entire screen.
    (glColor4f 0.0 0.0 0.0 0.4) ; Increase alpha to make the shadow more black.
    (glEnable GL_BLEND)
    (glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
    (glStencilFunc GL_NOTEQUAL 0 #xFFFFFFFF)
    (glStencilOp GL_KEEP GL_KEEP GL_KEEP)
    (glPushMatrix)
    (glLoadIdentity)
    (with-gl gl_triangle_strip
      (glVertex3f -0.1  0.1 -0.1)
      (glVertex3f -0.1 -0.1 -0.1)
      (glVertex3f  0.1  0.1 -0.1)
      (glVertex3f  0.1 -0.1 -0.1))
    (glPopMatrix)
    (glPopAttrib)))

(defmethod do-shadow-pass ((object shadowed-object) light-position)
  (with-slots (vertices faces) object
    (dolist (face faces)
      (when (face-visible-p face)
        (loop for neighbor in (face-neighbor face)
          for j upto 2
          do (if (or (null neighbor)
                     (not (face-visible-p neighbor)))
               (let* ((v1 (elt vertices (elt (face-indices face) j)))
                          (v2 (elt vertices (elt (face-indices face) (mod (1+ j) 3))))
                          (v3 (make-point :x (* (- (point-x v1) (gl-aref light-position 0)) *shadow-infinity*)
                                          :y (* (- (point-y v1) (gl-aref light-position 1)) *shadow-infinity*)
                                          :z (* (- (point-z v1) (gl-aref light-position 2)) *shadow-infinity*)))
                          (v4 (make-point :x (* (- (point-x v2) (gl-aref light-position 0)) *shadow-infinity*)
                                          :y (* (- (point-y v2) (gl-aref light-position 1)) *shadow-infinity*)
                                          :z (* (- (point-z v2) (gl-aref light-position 2)) *shadow-infinity*))))
                      (gl:with-gl GL_TRIANGLE_STRIP
                        (glVertex3f (point-x v1) (point-y v1) (point-z v1))
                        (glVertex3f (+ (point-x v1) (point-x v3))
                                    (+ (point-y v1) (point-y v3))
                                    (+ (point-z v1) (point-z v3)))
                        (glVertex3f (point-x v2) (point-y v2) (point-z v2))
                        (glVertex3f (+ (point-x v2) (point-x v4))
                                    (+ (point-y v2) (point-y v4))
                                    (+ (point-z v2) (point-z v4)))))))))))
                 
(defmethod load-shadow-object ((obj shadowed-object))
  (labels ((read-vertex (istream)
             (make-point :x (read istream)
                         :y (read istream)
                         :z (read istream)))
           (read-face (istream)
             (let* ((indices (loop for i below 3
                               collecting (read istream)))
                    (normals (loop for i below 3
                               collecting (read-vertex istream))))
               (make-face :indices indices
                          :normals normals
                          :neighbor nil))))
    (with-open-file (f (source obj) :direction :input)
      (let ((vcnt (read f :eof-error-p t)))
        (setf (vertices obj) (loop for i below vcnt 
                               collecting (read-vertex f)))
        (let ((fcnt (read f :eof-error-p t)))
          (setf (faces obj) (loop for i below fcnt
                              collecting (read-face f))))))))

(defmethod draw ((agent shadowed-object))
  (with-slots (vertices faces) agent
    (with-gl GL_TRIANGLES
      (dolist (face faces)
        (loop for index in (face-indices face)
              for face in (face-normals face)
              do (let ((vi (nth (1- index) vertices)))
                   (glNormal3fv (point->gl-vertex3f face))
                   (glVertex3fv (point->gl-vertex3f vi))))))))

;;;;
;;;

(defclass agent-room (agent-3d)
  ())

(defmethod draw ((room agent-room))
  (gl:with-gl GL_QUADS
    ;; Floor
    (glNormal3fv {0.0 1.0 0.0})
    (glVertex3fv {-10.0 -10.0 -20.0})
    (glVertex3fv {-10.0 -10.0 20.0})
    (glVertex3fv {10.0 -10.0 20.0})
    (glVertex3fv {10.0 -10.0 -20.0})
    ;; Ceiling
    (glNormal3fv {0.0 -1.0 0.0})
    (glVertex3fv {-10.0 10.0  20.0})
    (glVertex3fv {-10.0 10.0 -20.0})
    (glVertex3fv { 10.0 10.0 -20.0})
    (glVertex3fv { 10.0 10.0  20.0})
    ;; Front Wall
    (glNormal3fv {0.0 0.0 1.0})
    (glVertex3fv {-10.0  10.0 -20.0})
    (glVertex3fv {-10.0 -10.0 -20.0})
    (glVertex3fv { 10.0 -10.0 -20.0})
    (glVertex3fv { 10.0  10.0 -20.0})
    ;; Back Wall
    (glNormal3fv {0.0 0.0 -1.0})
    (glVertex3fv { 10.0  10.0 20.0})
    (glVertex3fv { 10.0 -10.0 20.0})
    (glVertex3fv {-10.0 -10.0 20.0})
    (glVertex3fv {-10.0  10.0 20.0})
    ;; Left Wall
    (glNormal3fv {1.0 0.0 0.0})
    (glVertex3fv {-10.0  10.0  20.0})
    (glVertex3fv {-10.0 -10.0  20.0})
    (glVertex3fv {-10.0 -10.0 -20.0})
    (glVertex3fv {-10.0  10.0 -20.0})
    ;; Right Wall
    (glNormal3fv {-1.0 0.0 0.0})
    (glVertex3fv { 10.0  10.0 -20.0})
    (glVertex3fv { 10.0 -10.0 -20.0})
    (glVertex3fv { 10.0 -10.0 20.0})
    (glVertex3fv { 10.0  10.0 20.0})))

;;;;
;;; Tests

(defun test-shadow-view-load-objects ()
  (let ((obj1 (make-instance 'shadowed-object :source "/Users/millejoh/Applications/dreaming-tree/nehe/Data/SimpleObject.txt")))
    (load-shadow-object obj1)
    obj1))

(defun test-shadowed-view-draw ()
  (slui (:application-window 
         :title "NeHe Lesson #27 - Shadows" :margin "0"
         (:shadow-view 
          :name "ShadowView" :vflex "1"
          (:shadowed-object :source "/Users/millejoh/Applications/dreaming-tree/nehe/Data/Object.txt")))))

(defun test-shadowed-view-draw2 ()
  (slui (:application-window
         :title "NeHe Lesson #27 - Shadows" :margin "0"
         (:shadow-view 
          :name "ShadowView" :vflex "1"
          (:shadowed-object :source "/Users/millejoh/Applications/dreaming-tree/nehe/Data/Object.txt")
          (:shadowed-object :source "/Users/millejoh/Applications/dreaming-tree/nehe/Data/Object1.txt"
                            :x 5.0)))))

(defun test-shadowed-view-draw3 ()
  (slui (:application-window
         :title "NeHe Lesson #27 - Shadows" :margin "0"
         (:shadow-view 
          :name "ShadowView" :vflex "1"
          (:camera :eye-z 5.0)
          (:shadowed-object :source "/Users/millejoh/Applications/dreaming-tree/nehe/Data/Object.txt")
          (:shadowed-object :source "/Users/millejoh/Applications/dreaming-tree/nehe/Data/Object1.txt"
                            :x 5.0)
          (:agent-room)))))

